home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / REAL Windo272419302001.psc / XPAPIs.bas < prev    next >
Encoding:
BASIC Source File  |  2001-09-30  |  2.1 KB  |  54 lines
  1. Attribute VB_Name = "XPAPIs"
  2.  
  3. Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
  4. Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
  5. Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINT_API) As Long
  6. Public Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINT_API) As Long
  7. Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
  8.  
  9. Public Type POINT_API
  10.     X As Long
  11.     Y As Long
  12. End Type
  13.  
  14. Public Enum BtnState
  15. Defaulted = PBS_DEFAULTED
  16. Disabled = PBS_DISABLED
  17. MouseOver = PBS_HOT
  18. Normal = PBS_NORMAL
  19. Pressed = PBS_PRESSED
  20. End Enum
  21.  
  22. Public Sub DrawButton(hWnd As Long, hDC As Long, DestRect As RECT, Caption As String, State As BtnState)
  23. 'This draws out the button, then button the text over it.
  24.     Dim hTheme As Long
  25.     hTheme = OpenThemeData(hWnd, "BUTTON")
  26.     DrawThemeBackground hTheme, hDC, BP_PUSHBUTTON, CLng(State), DestRect, ByVal 0&
  27.     DrawThemeText hTheme, hDC, BP_PUSHBUTTON, CLng(State), Caption, -1, DT_CENTER Or DT_VCENTER Or DT_WORD_ELLIPSIS Or DT_SINGLELINE, 0, DestRect
  28.     CloseThemeData hTheme
  29. End Sub
  30.  
  31. Public Function ThemesSupported() As Boolean
  32. ' First, we make sure that the UXTHEME.DLL file exsists.
  33. ' Then, we call 2 APIs that make sure that the current app is supposed to use themes.
  34. If CheckForDLL Then
  35. If CheckForThemes Then ThemesSupported = True
  36. End If
  37. End Function
  38.  
  39. Private Function CheckForDLL() As Boolean
  40. ' This sees if the UXTHEME.DLL exsists, meaning that it is XP or greater.
  41.     Dim hLib As Long
  42.     hLib = LoadLibrary("uxtheme.dll")
  43.     If hLib <> 0 Then FreeLibrary hLib
  44.     CheckForDLL = Not (hLib = 0)
  45. End Function
  46.  
  47. Private Function CheckForThemes() As Boolean
  48. ' If UXTHEME.DLL exsists, this function checks if we should really use themes.
  49. ' There are 2 cases we wouldn't:
  50. '   (1) The user set the apperance back to Windows Classic Style.
  51. '   (2) This program is running in compatibility mode with visual themes disabled.
  52.     If CBool(IsAppThemed) And CBool(IsThemeActive) Then CheckForThemes = True
  53. End Function
  54.